home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / prim / process.el < prev    next >
Encoding:
Text File  |  1995-06-01  |  11.2 KB  |  242 lines
  1. ;;; process.el --- commands for subprocesses; split out of simple.el
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  19. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. (defun start-process-shell-command (name buffer &rest args)
  22.   "Start a program in a subprocess.  Return the process object for it.
  23. Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
  24. NAME is name for process.  It is modified if necessary to make it unique.
  25. BUFFER is the buffer or (buffer-name) to associate with the process.
  26.  Process output goes at end of that buffer, unless you specify
  27.  an output stream or filter function to handle the output.
  28.  BUFFER may be also nil, meaning that this process is not associated
  29.  with any buffer
  30. Third arg is command name, the name of a shell command.
  31. Remaining arguments are the arguments for the command.
  32. Wildcards and redirection are handled as usual in the shell."
  33.   (if (eq system-type 'vax-vms)
  34.       (apply 'start-process name buffer args)
  35.     (start-process name buffer shell-file-name "-c"
  36.            (concat "exec " (mapconcat 'identity args " ")))))
  37.  
  38. (defun call-process (program &optional infile buffer display &rest args)
  39.   "Call PROGRAM synchronously in separate process.
  40. The program's input comes from file INFILE (nil means `/dev/null').
  41. Insert output in BUFFER before point; t means current buffer;
  42.  nil for BUFFER means discard it; 0 means discard and don't wait.
  43. Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  44. Remaining arguments are strings passed as command arguments to PROGRAM.
  45. If BUFFER is 0, returns immediately with value nil.
  46. Otherwise waits for PROGRAM to terminate
  47. and returns a numeric exit status or a signal description string.
  48. If you quit, the process is killed with SIGINT, or SIGKILL if you
  49. quit again."
  50.   (apply 'call-process-internal program infile buffer display args))
  51.  
  52. (defun call-process-region (start end program
  53.                             &optional deletep buffer displayp
  54.                             &rest args)
  55.   "Send text from START to END to a synchronous process running PROGRAM.
  56. Delete the text if fourth arg DELETE is non-nil.
  57. Insert output in BUFFER before point; t means current buffer;
  58.  nil for BUFFER means discard it; 0 means discard and don't wait.
  59. Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  60. Remaining args are passed to PROGRAM at startup as command args.
  61. If BUFFER is 0, returns immediately with value nil.
  62. Otherwise waits for PROGRAM to terminate
  63. and returns a numeric exit status or a signal description string.
  64. If you quit, the process is first killed with SIGINT, then with SIGKILL if
  65. you quit again before the process exits."
  66.   (let ((temp (cond ((eq system-type 'vax-vms)
  67.                      (make-temp-name "tmp:emacs"))
  68.                     ;;#### MS-DOS code needed
  69.                     (t
  70.                      (make-temp-name "/tmp/emacs")))))
  71.     (unwind-protect
  72.          (progn
  73.            (write-region start end temp nil 'silent)
  74.            (if deletep (delete-region start end))
  75.            (apply #'call-process program temp buffer displayp args))
  76.       (condition-case ()
  77.           (delete-file temp)
  78.         (file-error nil)))))
  79.  
  80.  
  81. (defun shell-command (command &optional flag)
  82.   "Execute string COMMAND in inferior shell; display output, if any.
  83. If COMMAND ends in ampersand, execute it asynchronously.
  84.  
  85. Optional second arg non-nil (prefix arg, if interactive)
  86. means insert output in current buffer after point (leave mark after it).
  87. This cannot be done asynchronously."
  88.   (interactive (list (read-shell-command "Shell command: ")
  89.              current-prefix-arg))
  90.   (if flag
  91.       (progn (barf-if-buffer-read-only)
  92.          (push-mark)
  93.          ;; We do not use -f for csh; we will not support broken use of
  94.          ;; .cshrcs.  Even the BSD csh manual says to use
  95.          ;; "if ($?prompt) exit" before things which are not useful
  96.          ;; non-interactively.  Besides, if someone wants their other
  97.          ;; aliases for shell commands then they can still have them.
  98.          (call-process shell-file-name nil t nil
  99.                "-c" command)
  100.          (exchange-point-and-mark t))
  101.     ;; Preserve the match data in case called from a program.
  102.     (let ((data (match-data)))
  103.       (unwind-protect
  104.       (if (string-match "[ \t]*&[ \t]*$" command)
  105.           ;; Command ending with ampersand means asynchronous.
  106.           (progn
  107.          (require 'background) ; whizzy comint background code
  108.          (background (substring command 0 (match-beginning 0))))
  109.         (shell-command-on-region (point) (point) command nil))
  110.     (store-match-data data)))))
  111.  
  112. (defun shell-command-on-region (start end command &optional flag interactive)
  113.   "Execute string COMMAND in inferior shell with region as input.
  114. Normally display output (if any) in temp buffer `*Shell Command Output*';
  115. Prefix arg means replace the region with it.
  116. Noninteractive args are START, END, COMMAND, FLAG.
  117. Noninteractively FLAG means insert output in place of text from START to END,
  118. and put point at the end, but don't alter the mark.
  119.  
  120. If the output is one line, it is displayed in the echo area,
  121. but it is nonetheless available in buffer `*Shell Command Output*'
  122. even though that buffer is not automatically displayed.  If there is no output
  123. or output is inserted in the current buffer then `*Shell Command Output*' is
  124. deleted." 
  125.   (interactive (list (min (point) (mark)) (max (point) (mark))
  126.              (read-shell-command "Shell command on region: ")
  127.              current-prefix-arg
  128.              (prefix-numeric-value current-prefix-arg)))
  129.   (if flag
  130.       ;; Replace specified region with output from command.
  131.       (let ((swap (and interactive (< (point) (mark)))))
  132.     ;; Don't muck with mark
  133.     ;; unless called interactively.
  134.     (and interactive (push-mark))
  135.     (call-process-region start end shell-file-name t t nil
  136.                  "-c" command)
  137.     (let ((shell-buffer (get-buffer "*Shell Command Output*")))
  138.       (and shell-buffer (not (eq shell-buffer (current-buffer)))
  139.            (kill-buffer shell-buffer)))
  140.     (and interactive swap (exchange-point-and-mark t)))
  141.       ;; No prefix argument: put the output in a temp buffer,
  142.       ;; replacing its entire contents.
  143.       (let ((buffer (get-buffer-create "*Shell Command Output*"))
  144.             (success nil)
  145.             (directory default-directory))
  146.         (unwind-protect
  147.              (if (eq buffer (current-buffer))
  148.                  ;; If the input is the same buffer as the output,
  149.                  ;; delete everything but the specified region,
  150.                  ;; then replace that region with the output.
  151.                  (progn
  152.                    (delete-region end (point-max))
  153.                    (delete-region (point-min) start)
  154.                    (call-process-region (point-min) (point-max)
  155.                                         shell-file-name t t nil
  156.                                         "-c" command)
  157.                    (setq success t))
  158.                  (progn
  159.                    ;; Clear the output buffer, 
  160.                    ;; then run the command with output there.
  161.                    (save-excursion
  162.                      (set-buffer buffer)
  163.                      ;; XEmacs change
  164.                      (setq default-directory directory)
  165.                      (erase-buffer))
  166.                    (call-process-region start end shell-file-name
  167.                                         nil buffer nil
  168.                                         "-c" command)
  169.                    (setq success t)))
  170.           ;; Report the amount of output.
  171.           (let ((lines (save-excursion
  172.                          (set-buffer buffer)
  173.                          (if (= (buffer-size) 0)
  174.                              0
  175.                              (count-lines (point-min) (point-max))))))
  176.             (cond ((= lines 0)
  177.                    (if success
  178.                        (message
  179.                         "(Shell command completed with no output)"))
  180.                    (kill-buffer buffer))
  181.                   ((and success (= lines 1))
  182.                    (message "%s"
  183.                             (save-excursion
  184.                               (set-buffer buffer)
  185.                               (goto-char (point-min))
  186.                               (buffer-substring (point)
  187.                                                 (progn (end-of-line)
  188.                                (point))))))
  189.                   (t 
  190.                    (set-window-start (display-buffer buffer) 1))))))))
  191.  
  192.  
  193. (defun start-process (name buffer program &rest program-args)
  194.   "Start a program in a subprocess.  Return the process object for it.
  195. Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
  196. NAME is name for process.  It is modified if necessary to make it unique.
  197. BUFFER is the buffer or (buffer-name) to associate with the process.
  198.  Process output goes at end of that buffer, unless you specify
  199.  an output stream or filter function to handle the output.
  200.  BUFFER may be also nil, meaning that this process is not associated
  201.  with any buffer
  202. Third arg is program file name.  It is searched for as in the shell.
  203. Remaining arguments are strings to give program as arguments.
  204. INCODE and OUTCODE specify the coding-system objects used in input/output
  205.  from/to the process."
  206.   (apply 'start-process-internal name buffer program program-args))
  207.  
  208. (defun open-network-stream (name buffer host service)
  209.   "Open a TCP connection for a service to a host.
  210. Returns a subprocess-object to represent the connection.
  211. Input and output work as for subprocesses; `delete-process' closes it.
  212. Args are NAME BUFFER HOST SERVICE.
  213. NAME is name for process.  It is modified if necessary to make it unique.
  214. BUFFER is the buffer (or buffer-name) to associate with the process.
  215.  Process output goes at end of that buffer, unless you specify
  216.  an output stream or filter function to handle the output.
  217.  BUFFER may be also nil, meaning that this process is not associated
  218.  with any buffer
  219. Third arg is name of the host to connect to, or its IP address.
  220. Fourth arg SERVICE is name of the service desired, or an integer
  221.  specifying a port number to connect to."
  222.   (open-network-stream-internal name buffer host service))
  223.  
  224. (defun shell-quote-argument (argument)
  225.   "Quote an argument for passing as argument to an inferior shell."
  226.   ;; Quote everything except POSIX filename characters.
  227.   ;; This should be safe enough even for really weird shells.
  228.   (let ((result "") (start 0) end)
  229.     (while (string-match "[^-0-9a-zA-Z_./]" argument start)
  230.       (setq end (match-beginning 0)
  231.         result (concat result (substring argument start end)
  232.                "\\" (substring argument end (1+ end)))
  233.         start (1+ end)))
  234.     (concat result (substring argument start))))
  235.  
  236. (defun exec-to-string (command)
  237.   "Execute COMMAND as an external process and return the output of that
  238. process as a string"
  239.   ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
  240.   (with-output-to-string
  241.     (call-process shell-file-name nil t nil "-c" command)))
  242.